library(forecast)
library(smooth)
BandaBeauOrdersTrain = BandaBeauOrdersGrouped[1:13,]
BandaBeauOrdersTest = BandaBeauOrdersGrouped[14:17,]
#Simple Moving Average
library(tseries)
‘tseries’ version: 0.10-45
‘tseries’ is a package for time series analysis and computational finance.
See ‘library(help="tseries")’ for details.
library(greybox)
library(smooth)
SMAmodel = sma(BandaBeauOrdersTrain$`Order Count`, h = 4)
summary(SMAmodel)
Time elapsed: 0.01 seconds
Model estimated: SMA(2)
Initial values were produced using backcasting.
2 parameters were estimated in the process
Residuals standard deviation: 43.039
Cost function type: MSE; Cost function value: 1567.356
Information criteria:
AIC AICc BIC BICc
136.5353 137.7353 137.6652 139.2042
SMAmodel.predict = forecast(SMAmodel, h = 4)
plot(SMAmodel.predict)

#Check Accuracy
sqrt(mean((SMAmodel.predict$forecast - BandaBeauOrdersTest$`Order Count`)^2))
[1] 53.68911
MAPE(SMAmodel.predict$forecast, BandaBeauOrdersTest$`Order Count`)
[1] 0.551
#Fit Holt Winters Model
HoltWintersModel = HoltWinters(BandaBeauOrdersTrain$`Order Count`, alpha = 0.2, beta = F, gamma = F)
#Predict using Holt Wintes model
HoltWintersModel.predict = forecast(HoltWintersModel, n.ahead = 4, prediction.interval = T)
#Plot predictions
plot(HoltWintersModel.predict)

#plot.ts(BandaBeauOrdersTrain$`Order Count`, xlim = c(1, 17))
#lines(HoltWintersModel$fitted[,1], col = "blue")
#lines(HoltWintersModel.predict[,1], col = "red")
# Calculate RMSE
sqrt(mean(HoltWintersModel.predict[,1] - BandaBeauOrdersTest$`Order Count`)^2)
Error in HoltWintersModel.predict[, 1] : incorrect number of dimensions
#Calculate MAPE
MAPE(HoltWintersModel.predict[,1], BandaBeauOrdersTest$`Order Count`)
[1] 0.512
HoltWintersModel.predict$mean
Time Series:
Start = 14
End = 23
Frequency = 1
[1] 64.64748 64.64748 64.64748 64.64748 64.64748 64.64748 64.64748 64.64748 64.64748
[10] 64.64748
#ARIMA model
ArimaModel = auto.arima(BandaBeauOrdersTrain$`Order Count`, trace = T, ic = "aic")
ARIMA(2,0,2) with non-zero mean : Inf
ARIMA(0,0,0) with non-zero mean : 136.8095
ARIMA(1,0,0) with non-zero mean : 137.3439
ARIMA(0,0,1) with non-zero mean : 137.6662
ARIMA(0,0,0) with zero mean : 146.0816
ARIMA(1,0,1) with non-zero mean : 139.1863
Best model: ARIMA(0,0,0) with non-zero mean
#ArimaModel = arima(BandaBeauOrdersTrain$`Order Count`, order = c(0,0,1))
summary(ArimaModel)
Series: BandaBeauOrdersTrain$`Order Count`
ARIMA(0,0,0) with non-zero mean
Coefficients:
mean
47.0000
s.e. 11.0967
sigma^2 estimated as 1734: log likelihood=-66.4
AIC=136.81 AICc=138.01 BIC=137.94
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set 2.186179e-14 40.00961 34 -196.37 228.871 0.9422633 0.3022105
confint(ArimaModel)
2.5 % 97.5 %
intercept 25.25083 68.74917
#Check ACF and PACF plots
acf(diff(BandaBeauOrdersTrain$`Order Count`))

#Check PACF plot
pacf(diff(BandaBeauOrdersTrain$`Order Count`))

ArimaModel.predict = forecast(ArimaModel, h = 4)
plot(ArimaModel.predict)

#Calculate accuracy
sqrt(mean((ArimaModel.predict$mean - BandaBeauOrdersTest$`Order Count`)^2))
[1] 25.36184
MAPE(ArimaModel.predict$mean, BandaBeauOrdersTest$`Order Count`)
[1] 0.481
summary(ArimaModel)
Call:
arima(x = BandaBeauOrdersTrain$`Order Count`, order = c(0, 0, 1))
Coefficients:
ma1 intercept
0.2885 48.4678
s.e. 0.2634 13.4326
sigma^2 estimated as 1456: log likelihood = -65.83, aic = 137.67
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set -0.9614872 38.16056 33.20744 -174.8805 206.4537 0.9202987 0.008750646
#Selected ARIMA model to be the best
#ArimaModel2 = auto.arima(BandaBeauOrdersTrain$`Order Count`, trace = T, ic = "aic")
ArimaModel2 = arima(BandaBeauOrdersGrouped$`Order Count`, order = c(0,0,5))
summary(ArimaModel2)
Call:
arima(x = BandaBeauOrdersGrouped$`Order Count`, order = c(0, 0, 5))
Coefficients:
ma1 ma2 ma3 ma4 ma5 intercept
0.1889 -0.1064 -0.3614 -0.3903 -0.3308 46.8794
s.e. 0.3151 0.3250 0.2900 0.3366 0.2485 4.8386
sigma^2 estimated as 942.1: log likelihood = -83.33, aic = 180.67
Training set error measures:
ME RMSE MAE MPE MAPE MASE ACF1
Training set -2.722802 30.69442 25.79768 -131.2096 156.142 0.8271802 -0.07404934
#Forecast for next 6 months
ArimaModel2.predict = forecast(ArimaModel2, h = 6)
NewDates = seq(from = as.Date("2018/11/01"), to = as.Date("2019/04/01"), "months")
#AllDates = rbind(BandaBeauOrdersGrouped$Date, NewDates)
AllDates = c(BandaBeauOrdersGrouped$Date, NewDates)
AllOrders = c(BandaBeauOrdersGrouped$`Order Count`, ArimaModel2.predict$mean)
AllOrders = round(AllOrders,0)
f = list(
family = "Courier New, monospace",
size = 18,
color = "#7f7f7f"
)
x = list(title = "Date", titlefont = f)
y = list(title = "Order Count", titlefont = f)
library(plotly)
fig <- plot_ly(x = AllDates, y = AllOrders, mode = "lines", type = "scatter", name = "Forecast", line = list(color = 'rgb(205, 12, 24)', width = 4)) %>% layout(xaxis = x, yaxis = y, title = "BandaBeau Orders") %>% add_trace(y = BandaBeauOrdersGrouped$`Order Count`, x = BandaBeauOrdersGrouped$Date, name = "Original" ,line = list(color = 'rgb(22, 96, 167)', width = 4))
fig
LS0tCnRpdGxlOiAiQmFuZGFCZWF1IE9yZGVycyBGb3JlY2FzdCIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKYGBge3J9CmxpYnJhcnkoZm9yZWNhc3QpCmxpYnJhcnkoc21vb3RoKQpgYGAKCmBgYHtyfQpCYW5kYUJlYXVPcmRlcnNUcmFpbiA9IEJhbmRhQmVhdU9yZGVyc0dyb3VwZWRbMToxMyxdCkJhbmRhQmVhdU9yZGVyc1Rlc3QgPSBCYW5kYUJlYXVPcmRlcnNHcm91cGVkWzE0OjE3LF0KYGBgCgpgYGB7cn0KI1NpbXBsZSBNb3ZpbmcgQXZlcmFnZQpsaWJyYXJ5KHRzZXJpZXMpCmxpYnJhcnkoZ3JleWJveCkKbGlicmFyeShzbW9vdGgpClNNQW1vZGVsID0gc21hKEJhbmRhQmVhdU9yZGVyc1RyYWluJGBPcmRlciBDb3VudGAsIGggPSA0KQpzdW1tYXJ5KFNNQW1vZGVsKQpgYGAKCmBgYHtyfQpTTUFtb2RlbC5wcmVkaWN0ID0gZm9yZWNhc3QoU01BbW9kZWwsIGggPSA0KQpwbG90KFNNQW1vZGVsLnByZWRpY3QpCmBgYApgYGB7cn0KI0NoZWNrIEFjY3VyYWN5CnNxcnQobWVhbigoU01BbW9kZWwucHJlZGljdCRmb3JlY2FzdCAtIEJhbmRhQmVhdU9yZGVyc1Rlc3QkYE9yZGVyIENvdW50YCleMikpCmBgYAoKYGBge3J9Ck1BUEUoU01BbW9kZWwucHJlZGljdCRmb3JlY2FzdCwgQmFuZGFCZWF1T3JkZXJzVGVzdCRgT3JkZXIgQ291bnRgKQpgYGAKCmBgYHtyfQojRml0IEhvbHQgV2ludGVycyBNb2RlbApIb2x0V2ludGVyc01vZGVsID0gSG9sdFdpbnRlcnMoQmFuZGFCZWF1T3JkZXJzVHJhaW4kYE9yZGVyIENvdW50YCwgYWxwaGEgPSAwLjIsIGJldGEgPSBGLCBnYW1tYSA9IEYpCiNQcmVkaWN0IHVzaW5nIEhvbHQgV2ludGVzIG1vZGVsCkhvbHRXaW50ZXJzTW9kZWwucHJlZGljdCA9IGZvcmVjYXN0KEhvbHRXaW50ZXJzTW9kZWwsIG4uYWhlYWQgPSA0LCBwcmVkaWN0aW9uLmludGVydmFsID0gVCkKI1Bsb3QgcHJlZGljdGlvbnMKcGxvdChIb2x0V2ludGVyc01vZGVsLnByZWRpY3QpCiNwbG90LnRzKEJhbmRhQmVhdU9yZGVyc1RyYWluJGBPcmRlciBDb3VudGAsIHhsaW0gPSBjKDEsIDE3KSkKI2xpbmVzKEhvbHRXaW50ZXJzTW9kZWwkZml0dGVkWywxXSwgY29sID0gImJsdWUiKQojbGluZXMoSG9sdFdpbnRlcnNNb2RlbC5wcmVkaWN0WywxXSwgY29sID0gInJlZCIpCmBgYAoKYGBge3J9CiMgQ2FsY3VsYXRlIFJNU0UKc3FydChtZWFuKEhvbHRXaW50ZXJzTW9kZWwucHJlZGljdFssMV0gLSBCYW5kYUJlYXVPcmRlcnNUZXN0JGBPcmRlciBDb3VudGApXjIpCmBgYAoKYGBge3J9CiNDYWxjdWxhdGUgTUFQRQpNQVBFKEhvbHRXaW50ZXJzTW9kZWwucHJlZGljdFssMV0sIEJhbmRhQmVhdU9yZGVyc1Rlc3QkYE9yZGVyIENvdW50YCkKYGBgCgpgYGB7cn0KSG9sdFdpbnRlcnNNb2RlbC5wcmVkaWN0JG1lYW4KYGBgCgpgYGB7cn0KI0FSSU1BIG1vZGVsCkFyaW1hTW9kZWwgPSBhdXRvLmFyaW1hKEJhbmRhQmVhdU9yZGVyc1RyYWluJGBPcmRlciBDb3VudGAsIHRyYWNlID0gVCwgaWMgPSAiYWljIikKI0FyaW1hTW9kZWwgPSBhcmltYShCYW5kYUJlYXVPcmRlcnNUcmFpbiRgT3JkZXIgQ291bnRgLCBvcmRlciA9IGMoMCwwLDEpKQpzdW1tYXJ5KEFyaW1hTW9kZWwpCmNvbmZpbnQoQXJpbWFNb2RlbCkKYGBgCgpgYGB7cn0KI0NoZWNrIEFDRiBwbG90CmFjZihkaWZmKEJhbmRhQmVhdU9yZGVyc1RyYWluJGBPcmRlciBDb3VudGApKQpgYGAKCmBgYHtyfQojQ2hlY2sgUEFDRiBwbG90CnBhY2YoZGlmZihCYW5kYUJlYXVPcmRlcnNUcmFpbiRgT3JkZXIgQ291bnRgKSkKYGBgCgpgYGB7cn0KQXJpbWFNb2RlbC5wcmVkaWN0ID0gZm9yZWNhc3QoQXJpbWFNb2RlbCwgaCA9IDQpCnBsb3QoQXJpbWFNb2RlbC5wcmVkaWN0KQpgYGAKCmBgYHtyfQojQ2FsY3VsYXRlIGFjY3VyYWN5CnNxcnQobWVhbigoQXJpbWFNb2RlbC5wcmVkaWN0JG1lYW4gLSBCYW5kYUJlYXVPcmRlcnNUZXN0JGBPcmRlciBDb3VudGApXjIpKQpgYGAKCmBgYHtyfQpNQVBFKEFyaW1hTW9kZWwucHJlZGljdCRtZWFuLCBCYW5kYUJlYXVPcmRlcnNUZXN0JGBPcmRlciBDb3VudGApCmBgYAoKYGBge3J9CnN1bW1hcnkoQXJpbWFNb2RlbCkKYGBgCmBgYHtyfQojU2VsZWN0ZWQgQVJJTUEgbW9kZWwgdG8gYmUgdGhlIGJlc3QKI0FyaW1hTW9kZWwyID0gYXV0by5hcmltYShCYW5kYUJlYXVPcmRlcnNUcmFpbiRgT3JkZXIgQ291bnRgLCB0cmFjZSA9IFQsIGljID0gImFpYyIpCkFyaW1hTW9kZWwyID0gYXJpbWEoQmFuZGFCZWF1T3JkZXJzR3JvdXBlZCRgT3JkZXIgQ291bnRgLCBvcmRlciA9IGMoMCwwLDUpKQpzdW1tYXJ5KEFyaW1hTW9kZWwyKQpgYGAKCmBgYHtyfQojRm9yZWNhc3QgZm9yIG5leHQgNiBtb250aHMKQXJpbWFNb2RlbDIucHJlZGljdCA9IGZvcmVjYXN0KEFyaW1hTW9kZWwyLCBoID0gNikKCmBgYAoKYGBge3J9Ck5ld0RhdGVzID0gc2VxKGZyb20gPSBhcy5EYXRlKCIyMDE4LzExLzAxIiksIHRvID0gYXMuRGF0ZSgiMjAxOS8wNC8wMSIpLCAibW9udGhzIikKI0FsbERhdGVzID0gcmJpbmQoQmFuZGFCZWF1T3JkZXJzR3JvdXBlZCREYXRlLCBOZXdEYXRlcykKQWxsRGF0ZXMgPSBjKEJhbmRhQmVhdU9yZGVyc0dyb3VwZWQkRGF0ZSwgTmV3RGF0ZXMpCkFsbE9yZGVycyA9IGMoQmFuZGFCZWF1T3JkZXJzR3JvdXBlZCRgT3JkZXIgQ291bnRgLCBBcmltYU1vZGVsMi5wcmVkaWN0JG1lYW4pCkFsbE9yZGVycyA9IHJvdW5kKEFsbE9yZGVycywwKQpgYGAKCmBgYHtyfQpmID0gbGlzdCgKICBmYW1pbHkgPSAiQ291cmllciBOZXcsIG1vbm9zcGFjZSIsCiAgc2l6ZSA9IDE4LAogIGNvbG9yID0gIiM3ZjdmN2YiCikKeCA9IGxpc3QodGl0bGUgPSAiRGF0ZSIsIHRpdGxlZm9udCA9IGYpCnkgPSBsaXN0KHRpdGxlID0gIk9yZGVyIENvdW50IiwgdGl0bGVmb250ID0gZikKbGlicmFyeShwbG90bHkpCmZpZyA8LSBwbG90X2x5KHggPSBBbGxEYXRlcywgeSA9IEFsbE9yZGVycywgbW9kZSA9ICJsaW5lcyIsIHR5cGUgPSAic2NhdHRlciIsIG5hbWUgPSAiRm9yZWNhc3QiLCBsaW5lID0gbGlzdChjb2xvciA9ICdyZ2IoMjA1LCAxMiwgMjQpJywgd2lkdGggPSA0KSkgJT4lIGxheW91dCh4YXhpcyA9IHgsIHlheGlzID0geSwgdGl0bGUgPSAiQmFuZGFCZWF1IE9yZGVycyIpICU+JSBhZGRfdHJhY2UoeSA9IEJhbmRhQmVhdU9yZGVyc0dyb3VwZWQkYE9yZGVyIENvdW50YCwgeCA9IEJhbmRhQmVhdU9yZGVyc0dyb3VwZWQkRGF0ZSwgbmFtZSA9ICJPcmlnaW5hbCIgLGxpbmUgPSBsaXN0KGNvbG9yID0gJ3JnYigyMiwgOTYsIDE2NyknLCB3aWR0aCA9IDQpKQpmaWcKYGBgCgoKCg==